$LINESIZE: 132
$PAGESIZE: 61
$STORAGE: 2
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                          M I C R O S A F E                           C
C                Structural Analysis by Finite Elements                C
C                     Module : SAFESOLV,  1st Part                     C
C                            Version : 2-D                             C
C                                                                      C
C         COPYRIGHT (C) by MICROSTRESS Corporation - 1985,1986         C
C                         ALL RIGHTS RESERVED                          C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      PROGRAM safesolv
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                          TYPE SPECIFICATION                          C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER ppmuqq,ofnflg,echflg,scrflg,ascstr,longi*4,longj*4,
     +        longk*4,longl*4,ddrive,odrive,previd,memava*4,numele*4
      DOUBLE PRECISION invqcn,stmtrx,stmqcn,disdof,beamcf,ftcons,pthick,
     +                 eyoung,pratio,diffnc,blngth,bmlcos,bmlsin,appldf,
     +                 ratio,sttemp,th
      CHARACTER inpfil*78,outfil*78,toufil*78,txtdisp*24,comand*127,
     +          space*2,string*5,datext*11,timtxt*12,intgst*25,dash*1,
     +          prompt*56,diamsg*110,reaclb*8,arrow*1,elipss*4,
     +          blank*1,ifdriv*6,ifpath*64,ifname*9,ifextn*5,flspec*78,
     +          ofdriv*6,ofpath*64,ofname*9,ofextn*5,toextn*5
      LOGICAL ffound
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                          ARRAY DIMENSIONING                          C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      DIMENSION invqcn(2,2),ftcons(9),diffnc(2,4),txtdisp(3),plints(3),
     +          baxial(600),bshear(2,600),bmomnt(2,600),inp(3),entry(8),
     +          sttemp(8,2),reaclb(3),youngm(20),poisson(20),
     +          lenhbw(1200),nodst3(400),igndof(1200),beamcf(3,3),
     +          mxndif(400),nodebm(2,600),bmarea(600),bminer(600),
     +          matcbm(600),bmdis1(600),bmdis2(600),plteth(500),
     +          matcpl(500),nodefs(2,60),fsarea(60),fsstif(60),
     +          nodepl(4,500)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                         COMMON SPECIFICATION                         C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      COMMON /global/ numdof,stmqcn(2,2)
      common /sizebw/ malhbw
      COMMON /plates/ disdof(1203),pltecf(2,4),plstrs(3,500),
     +                reafor(3,400),pstnor(3,400),pstacc(3,400)
      COMMON /aaaaaa/ stmtrx(8200)
      common /filenm/ inpfil,outfil
      common /forces/ appldf(1200)
      COMMON /dskrom/ scrflg,odrive
      common /coordi/ coonod(2,401)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                        USER DEFINED FUNCTIONS                        C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      previd(k,l)=MOD(k+l-2,l)+1
      nextid(k,l)=MOD(k,l)+1
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                        GENERAL INITIALIZATION                        C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      call time (inithr,initmn,initsc,iniths)
      call datstr (datext)
      call timstr (timtxt)
C
C  Show copyright notice on the screen.
C
      call logpsl
C
C  Initialize variables.
C
      scrflg=0
      maxban=6
      stmqcn(1,1)=0.
      stmqcn(1,2)=0.
      stmqcn(2,1)=0.
      stmqcn(2,2)=0.
      space='  '
      call setstr (2,space)
      toextn='.OUT '
      call setstr (5,toextn)
      elipss='... '
      call setstr (4,elipss)
      call defdrv (0,ddrive)
C
C  Determine number of stiffness matrix elements which will fit in RAM.
C
      numele=memava(stmtrx(1))/4
      if (numele .gt. 65535) numele=65535
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                         READ THE COMMAND TAIL                        C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      ierror=ppmuqq (0,0,comand)
      length=ascstr (1,comand)+2
      if (length .ne. 2) then
          call setstr (127,comand)
          call endstr (length,comand)
          call movstr (comand,1,0,space,1,1)
          call upcstr (comand)
          string=' I=  '
          call setstr (4,string)
          locatn=locstr (1,comand,string)+3
          if (locatn .ne. 3) then
              nxtloc=locstr (locatn,comand,space)
              if (nxtloc .eq. 0) nxtloc=length
              numchr=nxtloc-locatn
              inpfil='
     +                            '
              call setstr (78,inpfil)
              call movstr (inpfil,1,0,comand,locatn,numchr)
              call resstr (inpfil)
              ifnflg=1
          endif
          call modstr (string,2,79)
          locatn=locstr (1,comand,string)+3
          if (locatn .ne. 3) then
              nxtloc=locstr (locatn,comand,space)
              if (nxtloc .eq. 0) nxtloc=length
              numchr=nxtloc-locatn
              outfil='
     +                            '
              call setstr (78,outfil)
              call movstr (outfil,1,0,comand,locatn,numchr)
              call resstr (outfil)
              ofnflg=1
          endif
          string=' E   '
          call setstr (3,string)
          locatn=locstr (1,comand,string)
          if (locatn .ne. 0) echflg=1
          call modstr (string,2,83)
          locatn=locstr (1,comand,string)
          if (locatn .ne. 0) scrflg=1
      endif
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                     SET INPUT AND OUTPUT FILES                       C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   65 if (ifnflg .eq. 0) then
          WRITE (*,70)
   70     FORMAT (' Input data file name [.INP]? '\)
          READ (*,'(A)') inpfil
      else
          WRITE (*,72) inpfil
   72     FORMAT (' Input data file name [.INP]: ',a78)
      endif
      flspec=inpfil
      call parsfn (flspec,ddrive,ifdriv,idrive,ifpath,ifname,ifextn)
      inpfil=flspec
      if (lenstr(ifextn) .eq. 0) then
          ifextn='.INP '
          call setstr (5,ifextn)
          call constr (inpfil,ifextn)
      endif
      call resstr (inpfil)
      inquire (FILE=inpfil,EXIST=ffound)
      if (ffound) then
          OPEN (1,FILE=inpfil)
      else
          call setstr (78,inpfil)
          call pakstr (inpfil)
          length=lenstr (inpfil)
          call expstr (inpfil)
          call resstr (inpfil)
          call wrfstr (float(length),intgst)
          length=lenstr (intgst)
          prompt='('' ERROR : File "'',a  ,''" cannot be found. Try agai
     +n.'') '
          call setstr (56,prompt)
          call movstr (prompt,21,0,intgst,1,length)
          write (*,prompt) inpfil
          ifnflg=0
          goto 65
      ENDIF
   74 toufil=inpfil
      call setstr (78,toufil)
      locatn=locstr (1,toufil,ifextn)
      call movstr (toufil,locatn,1,toextn,1,4)
      length=lenstr (toufil)
      call expstr (toufil)
      call resstr (toufil)
      call wrfstr (float(length),intgst)
      length=lenstr (intgst)
      prompt='('' Output data file name ['',a  ,'']: '',a78 )
     +  '
      call setstr (56,prompt)
      call movstr (prompt,30,0,intgst,1,length)
      if (ofnflg .eq. 0) then
          call modstr (prompt,35,63)
          string='\    '
          call setstr (5,string)
          call movstr (prompt,38,0,string,1,4)
          call resstr (prompt)
          WRITE (*,prompt) toufil
          READ (*,'(A)') outfil
      else
          call resstr (prompt)
          WRITE (*,prompt) toufil,outfil
      endif
      flspec=outfil
      call parsfn (flspec,idrive-1,ofdriv,odrive,ofpath,ofname,ofextn)
      outfil=flspec
      IF (lenstr(ofdriv) .le. 2) then
          call setstr (78,outfil)
          call endstr (1,outfil)
          if (lenstr(ofdriv) .eq. 0) ofdriv=ifdriv
          if (lenstr(ofpath) .eq. 0) ofpath=ifpath
          if (lenstr(ofname) .eq. 0) ofname=ifname
          if (lenstr(ofextn) .eq. 0) ofextn=toextn
          call constr (outfil,ofdriv)
          call constr (outfil,ofpath)
          call constr (outfil,ofname)
          call constr (outfil,ofextn)
      endif
      call resstr (outfil)
      call opnfil (ierror)
      if (ierror .ne. 0) then
          ofnflg=0
          goto 74
      endif
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                         START THE OUTPUT FILE                        C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      call diskroom (0)
C
C  Header title
C
      call diskroom (331)
      WRITE (2,80,err=2000) datext,timtxt,inpfil,outfil
   80 FORMAT (' M I C R O S A F E --- STRUCTURAL ANALYSIS BY FINITE EL',
     +'EMENTS',4x,'Version: SAFESOLV (2-D)',2x,'Rel. 1.0',3x,a10,1x,a8//
     +/' Input data file  : ',A/' Output data file : ',A/)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                     START READING THE INPUT FILE                     C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      diamsg='Reading model data from file
     +                                                    '
      call setstr (110,diamsg)
      call setstr (78,inpfil)
      call movstr (diamsg,30,0,inpfil,1,77)
      call resstr (inpfil)
      call pakstr (diamsg)
      call constr (diamsg,elipss)
      call expstr (diamsg)
      call resstr (diamsg)
      call resstr (ofdriv)
      if (ofdriv .eq. 'CON:  ') scrflg=-1
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                 READ AND PROCESS THE MODEL SIZE LINES                C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C  Size header
C
      if (echflg .eq. 1) then
          if (scrflg .eq. 1) then
              WRITE (*,85)
   85         FORMAT (/' SIZE OF THE STRUCTURE'/)
          else
              if (scrflg .eq. 0) write (*,87) diamsg
   87         format (/1X,A/' Size...'\)
          endif
          call diskroom (30)
          WRITE (2,85,err=2000)
      else
          write (*,87) diamsg
      endif
C
C  Number of nodes and degrees of freedom
C
      CALL verify(1,entry,ierror,maxban,youngm)
      IF (ierror .NE. 0) GOTO 994
      nnodes=entry(1)
      if (echflg .eq. 1) then
          if (scrflg .eq. 1) WRITE (*,90) nnodes
   90     FORMAT (' Number of nodes                         :',I4)
          call diskroom (48)
          WRITE (2,90,err=2000) nnodes
      endif
      DO 92 loop=1,nnodes
      DO 92 indx=1,3
      reafor(indx,loop)=0.
      pstnor(indx,loop)=0.
   92 pstacc(indx,loop)=0.
      numdof=3*nnodes
      DO 94 loop=1,numdof
   94 appldf(loop)=0.
      malhbw=numele/numdof-2
      if (malhbw .gt. numdof) malhbw=numdof
      longj=numdof*(malhbw+2)
      do 96 longi=1,longj
   96 stmtrx(longi)=0.
C
C  Number of types of material
C
      CALL verify(2,entry,ierror,maxban,youngm)
      IF (ierror .NE. 0) GOTO 994
      nmater=entry(1)
      if (echflg .eq. 1) then
          if (scrflg .eq. 1) WRITE (*,98) nmater
   98     FORMAT (' Number of materials                     :',I4)
          call diskroom (48)
          WRITE (2,98,err=2000) nmater
      endif
C
C  Number of beams
C
      CALL verify(3,entry,ierror,maxban,youngm)
      IF (ierror .NE. 0) GOTO 994
      nbeams=entry(1)
      if (echflg .eq. 1) then
          if (scrflg .eq. 1) WRITE (*,100) nbeams
  100     FORMAT (' Number of beams                         :',I4)
          call diskroom (48)
          WRITE (2,100,err=2000) nbeams
      endif
C
C  Number of plates
C
      CALL verify(4,entry,ierror,maxban,youngm)
      IF (ierror .NE. 0) GOTO 994
      nplate=entry(1)
      if (echflg .eq. 1) then
          if (scrflg .eq. 1) WRITE (*,105) nplate
  105     FORMAT (' Number of plates                        :',I4)
          call diskroom (48)
          WRITE (2,105,err=2000) nplate
      endif
      DO 107 loop=1,nplate
      DO 107 indx=1,3
  107 plstrs(indx,loop)=0.
C
C  Number of fasteners
C
      CALL verify(5,entry,ierror,maxban,youngm)
      IF (ierror .NE. 0) GOTO 994
      nfastn=entry(1)
      if (echflg .eq. 1) then
          if (scrflg .eq. 1) WRITE (*,110) nfastn
  110     FORMAT (' Number of fasteners                     :',I4)
          call diskroom (48)
          WRITE (2,110,err=2000) nfastn
      endif
C
C  Number of loaded nodes
C
      CALL verify(6,entry,ierror,maxban,youngm)
      IF (ierror .NE. 0) GOTO 994
      nlnods=entry(1)
      if (echflg .eq. 1) then
          if (scrflg .eq. 1) WRITE (*,115) nlnods
  115     FORMAT (' Number of loaded nodes                  :',I4)
          call diskroom (48)
          WRITE (2,115,err=2000) nlnods
      endif
C
C  Number of restrained degrees of freedom
C
      CALL verify(7,entry,ierror,maxban,youngm)
      IF (ierror .NE. 0) GOTO 994
      nresdf=entry(1)
      if (echflg .eq. 1) then
          if (scrflg .eq. 1) WRITE (*,120) nresdf
  120     FORMAT (' Number of restrained degrees of freedom :',I4)
          call diskroom (48)
          WRITE (2,120,err=2000) nresdf
      endif
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C              READ AND PROCESS THE NODE COORDINATES LINES             C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C  Coordinates of the nodes
C
      if (echflg .eq. 1) then
          if (scrflg .eq. 1) then
              WRITE (*,125)
  125         FORMAT (//' NODE COORDINATES'//' Node   Coordinate X   ',
     +                'Coordinate Y'/)
          else
              if (scrflg .eq. 0) write (*,130)
  130         format ('Nodes...'\)
          endif
          call diskroom (68)
          WRITE (2,125,err=2000)
      else
          write (*,130)
      endif
      call chkdup (0,ierror)
      DO 160 loop=1,nnodes
      CALL verify(8,entry,ierror,maxban,youngm)
      IF (ierror .NE. 0) GOTO 994
      i=entry(1)
      coonod(1,i)=entry(2)
      coonod(2,i)=entry(3)
      if (echflg .eq. 1) then
          if (scrflg .eq. 1) WRITE (*,150) i,entry(2),entry(3)
  150     FORMAT (I5,3X,F12.5,3X,F12.5)
          call diskroom (37)
          WRITE (2,150,err=2000) i,entry(2),entry(3)
      endif
  160 CONTINUE
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C             READ AND PROCESS THE MATERIAL PROPERTIES LINES           C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C  Material properties
C
      if (nmater .gt. 0) then
          if (echflg .eq. 1) then
              if (scrflg .eq. 1) then
                  write (*,170)
  170             FORMAT (//' MATERIAL PROPERTIES'//' Code    Young',
     +                    1H','s modulus','   Poisson',1H','s ratio'/)
              else
                  if (scrflg .eq. 0) write (*,175)
  175             format ('Materials...'\)
              endif
              call diskroom (78)
              WRITE (2,170,err=2000)
          else
              write (*,175)
          endif
          call chkdup (0,ierror)
          DO 190 loop=1,nmater
          CALL verify(9,entry,ierror,maxban,youngm)
          IF (ierror .NE. 0) GOTO 994
          i=entry(1)
          youngm(i)=entry(2)
          poisson(i)=entry(3)
          if (echflg .eq. 1) then
              if (scrflg .eq. 1) WRITE (*,180) i,entry(2),entry(3)
  180         FORMAT (I5,5X,F11.0,8X,F8.5)
              call diskroom (39)
              WRITE (2,180,err=2000) i,entry(2),entry(3)
          endif
  190     CONTINUE
      endif
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                    READ AND PROCESS THE BEAM LINES                   C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C  Beams
C
      IF (nbeams .gt. 0) then
          if (echflg .eq. 1) then
              if (scrflg .eq. 1) then
                  write (*,200)
  200             FORMAT (//' BEAM DATA'//' Beam     I     J      ',
     +                    'Length      Area    M. Inertia',
     +                    '   Material       Distributed Loads'/)
              else
                  if (scrflg .eq. 0) write (*,205)
  205             format ('Beams...'\)
              endif
              call diskroom (114)
              WRITE (2,200,err=2000)
          else
              write (*,205)
          endif
          call chkdup (0,ierror)
          DO 220,loop=1,nbeams
          CALL verify(10,entry,ierror,maxban,youngm)
          IF (ierror .NE. 0) GOTO 994
          i=entry(1)
          n1=entry(2)
          n2=entry(3)
          mat=entry(6)
          bmarea(i)=entry(4)
          matcbm(i)=mat
          eyoung=youngm(mat)
          if ((entry(4) .ne. 0.) .and. (eyoung .ne. 0.)) then
              nodebm(1,i)=n1
              nodebm(2,i)=n2
              bminer(i)=entry(5)
              bmdis1(i)=entry(7)
              bmdis2(i)=entry(8)
              mxndif(n1)=MAX(n1,n2,mxndif(n1))
              mxndif(n2)=MAX(n1,n2,mxndif(n2))
          endif
          diffnc(1,2)=coonod(1,n2)-coonod(1,n1)
          diffnc(2,2)=coonod(2,n2)-coonod(2,n1)
          blngth=DSQRT(diffnc(1,2)*diffnc(1,2)+diffnc(2,2)*diffnc(2,2))
          if (echflg .eq. 1) then
              if (scrflg .eq. 1) WRITE (*,210) i,n1,n2,blngth,entry(4),
     +                           entry(5),mat,entry(7),entry(8)
  210         FORMAT (I5,2I6,F12.3,F10.4,F14.5,5X,I3,5X,2F12.3)
              call diskroom (92)
              WRITE (2,210,err=2000) i,n1,n2,blngth,entry(4),entry(5),
     +                               mat,entry(7),entry(8)
          endif
          if ((entry(4) .ne. 0.) .and. (eyoung .ne. 0.)) then
              bmlcos=diffnc(1,2)/blngth
              bmlsin=diffnc(2,2)/blngth
              IF (entry(5) .NE. 0.) THEN
                  nodst3(n1)=1
                  nodst3(n2)=1
              ENDIF
              I3=3*n1
              I2=I3-1
              I1=I2-1
              J3=3*n2
              J2=J3-1
              J1=J2-1
              IF ((entry(7) .NE. 0.) .OR. (entry(8) .NE. 0.)) THEN
                  ftcons(1)=entry(7)*blngth/6
                  ftcons(2)=entry(8)*blngth/6
                  ftcons(3)=ftcons(1)*blngth/30
                  ftcons(4)=ftcons(2)*blngth/30
                  appldf(I1)=appldf(I1)-bmlsin*(2*ftcons(1)+ftcons(2))
                  appldf(I2)=appldf(I2)+bmlcos*(2*ftcons(1)+ftcons(2))
                  appldf(I3)=appldf(I3)+8*ftcons(3)+7*ftcons(4)
                  appldf(j1)=appldf(j1)-bmlsin*(ftcons(1)+2*ftcons(2))
                  appldf(j2)=appldf(j2)+bmlcos*(ftcons(1)+2*ftcons(2))
                  appldf(j3)=appldf(j3)-7*ftcons(3)-8*ftcons(4)
              ENDIF
              ftcons(1)=2*eyoung*entry(5)/blngth
              ftcons(2)=entry(4)*eyoung/blngth
              ftcons(3)=bmlsin/blngth
              ftcons(4)=bmlcos/blngth
              ftcons(5)=6*ftcons(1)*ftcons(3)*ftcons(3)+
     +                  bmlcos*bmlcos*ftcons(2)
              ftcons(6)=6*ftcons(1)*ftcons(3)*ftcons(4)-
     +                  bmlcos*bmlsin*ftcons(2)
              ftcons(7)=6*ftcons(1)*ftcons(4)*ftcons(4)+
     +                  bmlsin*bmlsin*ftcons(2)
              ftcons(8)=-3*ftcons(1)*ftcons(3)
              ftcons(9)=-3*ftcons(1)*ftcons(4)
              CALL assemble (I1,I1,ftcons(5),-ftcons(6),ftcons(8))
              CALL assemble (I1,j1,-ftcons(5),ftcons(6),ftcons(8))
              CALL assemble (I2,I2,ftcons(7),-ftcons(9),0.)
              CALL assemble (I2,j1,ftcons(6),-ftcons(7),-ftcons(9))
              CALL assemble (I3,I3,ftcons(1)*2,0.,0.)
              CALL assemble (I3,j1,-ftcons(8),ftcons(9),ftcons(1))
              CALL assemble (j1,j1,ftcons(5),-ftcons(6),-ftcons(8))
              CALL assemble (j2,j2,ftcons(7),ftcons(9),0.)
              CALL assemble (j3,j3,ftcons(1)*2,0.,0.)
          else
              if (scrflg .ge. 0) write (*,215) i
  215         FORMAT (/' WARNING : The beam',I4,
     +        ' has been disconnected from the model.'/)
              call diskroom (69)
              WRITE (2,215,err=2000) i
              if ((echflg .eq. 0) .or. (scrflg .eq. 0)) write(*,217)
  217         format (' '\)
          endif
  220     CONTINUE
      endif
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                    READ AND PROCESS THE PLATE LINES                  C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C  Plates
C
      IF (nplate .gt. 0) then
          if (echflg .eq. 1) then
              if (scrflg .eq. 1) then
                  write (*,240)
  240             FORMAT (//' PLATE DATA'//' Plate    I     J     K',
     +                    '     L   Thickness  Material'/)
              else
                  if (scrflg .eq. 0) write (*,245)
  245             format ('Plates...'\)
              endif
              call diskroom (78)
              WRITE (2,240,err=2000)
          else
              write (*,245)
          endif
          call chkdup (0,ierror)
          DO 360,loop=1,nplate
          CALL verify(11,entry,ierror,maxban,youngm)
          IF (ierror .NE. 0) GOTO 994
          i=entry(1)
          n1=entry(2)
          n2=entry(3)
          n3=entry(4)
          n4=entry(5)
          pthick=entry(6)
          mat=entry(7)
          if (echflg .eq. 1) then
              if (scrflg .eq. 1) WRITE (*,250) i,N1,n2,N3,N4,pthick,mat
  250         FORMAT (I5,4I6,F11.5,5X,I3)
              call diskroom (50)
              WRITE (2,250,err=2000) i,N1,n2,N3,N4,pthick,mat
          endif
          plteth(i)=entry(6)
          matcpl(i)=mat
          eyoung=youngm(mat)
          if ((pthick .ne. 0.) .and. (eyoung .ne. 0.)) then
              pratio=poisson(mat)
              indx=MAX(n1,n2,n3,n4)
              mxndif(n1)=MAX(mxndif(N1),indx)
              mxndif(n2)=MAX(mxndif(N2),indx)
              mxndif(n3)=MAX(mxndif(N3),indx)
              IF (n4 .GT. 0) mxndif(N4)=MAX(mxndif(N4),indx)
              diffnc(1,2)=coonod(1,N2)-coonod(1,N1)
              diffnc(2,2)=coonod(2,N2)-coonod(2,N1)
              diffnc(1,3)=coonod(1,N3)-coonod(1,N2)
              diffnc(2,3)=coonod(2,N3)-coonod(2,N2)
              IF (N4 .EQ. 0) THEN
                  diffnc(1,1)=coonod(1,N1)-coonod(1,N3)
                  diffnc(2,1)=coonod(2,N1)-coonod(2,N3)
              ELSE
                  diffnc(1,4)=coonod(1,N4)-coonod(1,N3)
                  diffnc(2,4)=coonod(2,N4)-coonod(2,N3)
                  diffnc(1,1)=coonod(1,N1)-coonod(1,N4)
                  diffnc(2,1)=coonod(2,N1)-coonod(2,N4)
              ENDIF
              INDX=1
              IF (diffnc(1,2)*diffnc(2,3) .GT. diffnc(2,2)*diffnc(1,3))
     +            INDX=INDX+4
              IF (N4 .EQ. 0) THEN
                  IF (INDX .EQ. 1) THEN
                      n=n2
                      n2=n3
                      n3=n
                  ENDIF
              ELSE
                  IF (diffnc(1,3)*diffnc(2,4) .GT.
     +                diffnc(2,3)*diffnc(1,4)) INDX=INDX+2
                  IF (diffnc(1,4)*diffnc(2,1) .GT.
     +                diffnc(2,4)*diffnc(1,1)) INDX=INDX+1
                  GOTO (260,270,280,300,310,280,300,320) indx
  260                 n=n2
                      n2=n4
                      n4=n
                      GOTO 320
  270                 n=n2
                      n2=n3
                      n3=n
                      GOTO 320
  280                 WRITE (*,290) i
  290                 FORMAT (' ERROR : ILLEGAL NODE DECLARATION FOR ',
     +                        'PLATE',I4,'.')
                      call diskroom (50)
                      WRITE (2,290,err=2000) i
                      goto 994
  300                 n=n2
                      n2=n3
                      n3=n4
                      n4=n
                      GOTO 320
  310                 n=n3
                      n3=n4
                      n4=n
  320             CONTINUE
              ENDIF
              nodepl(1,i)=N1
              nodepl(2,i)=N2
              nodepl(3,i)=N3
              nodepl(4,i)=N4
              IF (N4 .EQ. 0) THEN
                  CALL triasemb (N1,N2,N3,pthick,eyoung,pratio)
              ELSE
                  coonod(1,nnodes+1)=(coonod(1,N1)+coonod(1,N2)+
     +                                coonod(1,N3)+coonod(1,N4))/4
                  coonod(2,nnodes+1)=(coonod(2,N1)+coonod(2,N2)+
     +                                coonod(2,N3)+coonod(2,N4))/4
                  CALL triasemb (N1,N2,nnodes+1,pthick,eyoung,pratio)
                  CALL triasemb (N2,N3,nnodes+1,pthick,eyoung,pratio)
                  CALL triasemb (N3,N4,nnodes+1,pthick,eyoung,pratio)
                  CALL triasemb (N4,N1,nnodes+1,pthick,eyoung,pratio)
                  ftcons(1)=stmqcn(1,1)*stmqcn(2,2)-
     +                      stmqcn(1,2)*stmqcn(2,1)
                  invqcn(1,1)=stmqcn(2,2)/ftcons(1)
                  invqcn(2,2)=stmqcn(1,1)/ftcons(1)
                  invqcn(1,2)=-stmqcn(1,2)/ftcons(1)
                  invqcn(2,1)=invqcn(1,2)
                  DO 330 NI=1,4
                  DO 330 MI=1,2
                  n=(nodepl(NI,i)-1)*3+MI
                  DO 330 NJ=NI,4
                  IF (NJ .EQ. NI) THEN
                      MK=MI
                  ELSE
                      MK=1
                  ENDIF
                  DO 330 mj=MK,2
                  J=(nodepl(NJ,i)-1)*3+MJ
                  k=min(n,j)
                  l=max(n,j)-k+1
                  longk=(malhbw+2)*(k-1)+l
                  do 332 m=1,2
                  longi=(malhbw+2)*(n-1)+malhbw+m
                  ftcons(2)=0.
                  do 331 mm=1,2
                  longj=(malhbw+2)*(j-1)+malhbw+mm
  331             ftcons(2)=ftcons(2)+stmtrx(longj)*invqcn(m,mm)
  332             stmtrx(longk)=stmtrx(longk)-ftcons(2)*stmtrx(longi)
  330             CONTINUE
                  DO 350 NI=1,2
                  DO 340 M=1,4
                  DO 340 MI=1,2
                  longi=(malhbw+2)*((nodepl(M,i)-1)*3+MI)+ni-2
                  stmtrx(longi)=0.
  340             CONTINUE
                  DO 345 MI=1,2
  345             stmqcn(mi,ni)=0.
  350             CONTINUE
              ENDIF
          else
              if (scrflg .ge. 0) write (*,355) i
  355         FORMAT (/' WARNING : The plate',I4,
     +        ' has been disconnected from the model.'/)
              call diskroom (70)
              WRITE (2,355,err=2000) i
              if ((echflg .eq. 0) .or. (scrflg .eq. 0)) write(*,217)
          endif
  360     CONTINUE
      endif
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                  READ AND PROCESS THE FASTENER LINES                 C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C  Fasteners
C
      IF (nfastn .gt. 0) then
          if (echflg .eq. 1) then
              if (scrflg .eq. 1) then
                  WRITE (*,380)
  380             FORMAT (//' FASTENER DATA'//
     +                    ' Fastener I     J      Area    Stiffness'/)
              else
                  if (scrflg .eq. 0) write (*,385)
  385             format ('Fasteners...'\)
              endif
              call diskroom (70)
              WRITE (2,380,err=2000)
          else
              write (*,385)
          endif
          call chkdup (0,ierror)
          DO 400 loop=1,nfastn
          CALL verify(12,entry,ierror,maxban,youngm)
          IF (ierror .NE. 0) GOTO 994
          i=entry(1)
          n1=entry(2)
          n2=entry(3)
          if (echflg .eq. 1) then
              if (scrflg .eq. 1) WRITE (*,390) i,n1,n2,entry(4),entry(5)
  390         FORMAT (I5,2I6,F12.6,F11.0)
              call diskroom (42)
              WRITE (2,390,err=2000) i,n1,n2,entry(4),entry(5)
          endif
          fsstif(i)=entry(5)
          if (entry(5) .ne. 0.) then
              ftcons(1)=entry(5)
              nodefs(1,i)=n1
              nodefs(2,i)=n2
              fsarea(i)=entry(4)
              I1=3*n1-2
              I2=I1+1
              J1=3*n2-2
              J2=J1+1
              mxndif(n1)=MAX(n1,n2,mxndif(n1))
              mxndif(n2)=MAX(n1,n2,mxndif(n2))
              CALL assemble (I1,I1,ftcons(1),0.,0.)
              CALL assemble (I1,j1,-ftcons(1),0.,0.)
              CALL assemble (I2,I2,ftcons(1),0.,0.)
              CALL assemble (I2,j2,-ftcons(1),0.,0.)
              CALL assemble (j1,j1,ftcons(1),0.,0.)
              CALL assemble (j2,j2,ftcons(1),0.,0.)
          else
              if (scrflg .ge. 0) write (*,395) i
  395         FORMAT (/' WARNING : The fastener',I4,
     +        ' has been disconnected from the model.'/)
              call diskroom (73)
              WRITE (2,395,err=2000) i
              if ((echflg .eq. 0) .or. (scrflg .eq. 0)) write(*,217)
          endif
  400     CONTINUE
      endif
C
C  Fix unstiffened degrees of freedom
C
      DO 470 loop=1,nnodes
      N1=3*loop-2
      IF (nodst3(loop) .ne. 1) then
          IF (mxndif(loop) .EQ. 0) THEN
              if (scrflg .ge. 0) write (*,465) loop
  465         FORMAT (/' WARNING : The node',I4,
     +        ' is not connected to any element in the model.'/)
              call diskroom (77)
              WRITE (2,465,err=2000) loop
              if ((echflg .eq. 0) .or. (scrflg .eq. 0)) write(*,217)
              igndof(n1)=1
              disdof(n1)=0.
              igndof(n1+1)=1
              disdof(n1+1)=0.
          ENDIF
          igndof(N1+2)=1
          disdof(N1+2)=0.
      endif
  470 CONTINUE
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                 READ AND PROCESS THE NODE LOADS LINES                C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C  Node loads
C
      IF (nlnods .gt. 0) then
          if (echflg .eq. 1) then
              if (scrflg .eq. 1) then
                  WRITE (*,410)
  410             FORMAT (//' NODE LOADS'//' Node             PX',
     +                    '            PY            MZ'/)
              else
                  if (scrflg .eq. 0) write (*,415)
  415             format ('Loads...'\)
              endif
              call diskroom (75)
              WRITE (2,410,err=2000)
          else
              write (*,415)
          endif
          call chkdup (0,ierror)
          DO 450 loop=1,nlnods
          CALL verify(13,entry,ierror,maxban,youngm)
          IF (ierror .NE. 0) GOTO 994
          i=entry(1)
          if (echflg .eq. 1) then
              if (scrflg .eq. 1) WRITE (*,440) i,entry(2),entry(3),
     +                                         entry(4)
  440         FORMAT (I5,1X,3F14.2)
              call diskroom (50)
              WRITE (2,440,err=2000) i,entry(2),entry(3),entry(4)
          endif
          N1=3*i-3
          DO 445 j=1,3
          appldf(N1+J)=appldf(N1+J)+entry(j+1)
  445     reafor(J,i)=reafor(J,i)-entry(j+1)
  450     CONTINUE
      endif
C
C  Initialize displacements
C
      DO 460 loop=1,numdof
  460 disdof(loop)=appldf(loop)
C
C  Determine last non-zero element in each row
C
      i=0
      JHB=6
      DO 480 loop=1,nnodes
      J=3*(mxndif(loop)-loop+1)
      IF (J .LT. JHB) THEN
          J=JHB
      ELSE
          JHB=J
      ENDIF
      DO 480 K=1,3
      i=i+1
      lenhbw(i)=min(j,numdof-i+1)
      j=j-1
  480 CONTINUE
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C              READ AND PROCESS THE NODE RESTRAINTS LINES              C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C  Fixed displacements
C
      IF (nresdf .gt. 0) then
          if (echflg .eq. 1) then
              if (scrflg .eq. 1) then
                  WRITE (*,490)
  490             FORMAT (//' MOVEMENT RESTRAINTS'//' Node           ',
     +                    'Type of restraint         Displacement'/)
              else
                  if (scrflg .eq. 0) write (*,495)
  495             format ('Restraints...'\)
              endif
              call diskroom (90)
              WRITE (2,490,err=2000)
          else
              write (*,495)
          endif
          call chkdup (0,ierror)
          txtdisp(1)='Translation along X axis'
          txtdisp(2)='Translation along Y axis'
          txtdisp(3)=' Rotation about Z axis  '
          DO 510 loop=1,nresdf
          CALL verify(14,entry,ierror,maxban,youngm)
          IF (ierror .NE. 0) GOTO 994
          i=entry(1)
          indxfd=entry(2)
          if (echflg .eq. 1) then
              if (scrflg .eq. 1) WRITE (*,500) i,txtdisp(indxfd),
     +                                         entry(3)
  500         FORMAT (I5,8X,A24,F15.5)
              call diskroom (54)
              WRITE (2,500,err=2000) i,txtdisp(indxfd),entry(3)
          endif
          N1=3*(i-1)+indxfd
          disdof(N1)=entry(3)
          IF (entry(3) .EQ. 0.) THEN
              igndof(N1)=2
          ELSE
              longi=(malhbw+2)*(n1-1)+1
              stmtrx(longi)=1D30
              disdof(N1)=stmtrx(longi)*entry(3)
              igndof(N1)=-2
          ENDIF
  510     CONTINUE
      endif
      CLOSE (1)
      if ((echflg .eq. 0) .or. (scrflg .eq. 0)) WRITE (*,512)
  512 format ('End')
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C   SOLVE THE SYSTEM [K]{u}={F} AND REPORT THE RESULTS IN THE SCREEN   C
C                          AND THE OUTPUT FILE                         C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      write (*,522) numdof,maxban
  522 format (/' Solving the system [K]{u}={F}...'/' Number of degrees',
     +         ' of freedom :',i5,'          Bandwidth :'i4//
     +         ' PASS 1 : FORWARD ELIMINATION')
      i1=1+numdof/80
      j1=numdof/i1-2
      k1=78-j1
      dash='-'
      arrow=''
      write (*,524) arrow,(dash,i=1,j1),arrow,(blank,j=1,k1)
  524 format (1x,80a1)
C
C  Calculate displacements
C
      longi=-malhbw-1
      DO 535 I=1,numdof
      if (nextid(i,i1) .eq. 1) call pacer
      longi=longi+malhbw+2
      IF (igndof(I) .le. 0) then
          IF (ABS(stmtrx(longi)) .LT. .000001) THEN
              i1=(i-1)/3+1
              j1=i-3*(i1-1)
              WRITE (*,525) i1,j1
  525         FORMAT (//' ERROR : THE STIFFNESS MATRIX APPEARS TO BE',
     +                ' SINGULAR.'/' The elements connected to node ',i3
     +                ,' do not contribute any stiffness in the free'/
     +                ' degree of freedom ',i1,'.'/)
              call diskroom (162)
              WRITE (2,525,err=2000) i1,j1
              goto 994
          endif
          DO 530 J=1,lenhbw(I)-1
          l=i+j
          IF ((igndof(l) .le. 0) .and. (stmtrx(longi+j) .ne. 0.)) then
              RATIO=stmtrx(longi+j)/stmtrx(longi)
              longl=(malhbw+2)*j+longi-1
              DO 529 k=j+1,lenhbw(I)
              longl=longl+1
              IF (igndof(l) .le. 0) stmtrx(longl)=stmtrx(longl)-
     +                              ratio*stmtrx(longi-1+k)
  529         CONTINUE
              stmtrx(longi+j)=ratio
              disdof(l)=disdof(l)-RATIO*disdof(I)
          endif
  530     CONTINUE
          disdof(i)=disdof(i)/stmtrx(longi)
      ENDIF
  535 CONTINUE
      write (*,536)
  536 format (/' PASS 2 : BACKWARDS SUBSTITUTION')
      write (*,524) arrow,(dash,i=1,j1),arrow,(blank,j=1,k1)
      if (nextid(numdof,i1) .eq. 1) call pacer
      DO 550 i=numdof-1,1,-1
      if (nextid(i,i1) .eq. 1) call pacer
      longj=(malhbw+2)*(i-1)+1
      IF (igndof(i) .le. 0) then
          DO 540 K=1,lenhbw(i)-1
  540     disdof(i)=disdof(i)-stmtrx(longj+k)*disdof(i+k)
      endif
  550 CONTINUE
      write (*,555)
  555 format (/' The system has been succesfully solved.')
C
C  Print displacements
C
      if (scrflg .eq. 0) then
          diamsg='Writing results to file
     +                                                        '
          call setstr (110,diamsg)
          call setstr (78,outfil)
          call movstr (diamsg,25,1,outfil,1,77)
          call resstr (outfil)
          call pakstr (diamsg)
          call constr (diamsg,elipss)
          call expstr (diamsg)
          call resstr (diamsg)
          write (*,680) diamsg
  680     format (/1X,A/' Displacements...'\)
      endif
      if (scrflg .eq. 1) THEN
          WRITE (*,685)
  685     FORMAT (//' NODE DISPLACEMENTS'//
     +    ' Node         U           V         Omega'/)
      endif
      call diskroom (76)
      WRITE (2,685,err=2000)
      DO 700 J=1,nnodes
      if (mxndif(j) .ne. 0) then
          if (scrflg .eq. 1) WRITE (*,690) j,(disdof(3*(j-1)+i),i=1,3)
  690     FORMAT (I5,1X,3F12.6)
          call diskroom (44)
          WRITE (2,690,err=2000) j,(disdof(3*(j-1)+i),i=1,3)
      endif
  700 CONTINUE
C
C  Beam corner forces
C
      IF (nbeams .gt. 0) then
          if (scrflg .eq. 1) then
              WRITE (*,710)
  710         FORMAT (//' BEAM CORNER FORCES'//
     +        ' Beam     I     J          FX1         FY1         MZ1',
     +        '         FX2         FY2         MZ2'/)
          else
              if (scrflg .eq. 0) write (*,205)
          endif
          call diskroom (125)
          WRITE (2,710,err=2000)
          DO 740 i=1,nbeams
          mat=matcbm(i)
          eyoung=youngm(mat)
          if ((eyoung .ne. 0.) .and. (bmarea(i) .ne. 0.)) then
              n1=nodebm(1,i)
              n2=nodebm(2,i)
              diffnc(1,2)=coonod(1,n2)-coonod(1,n1)
              diffnc(2,2)=coonod(2,n2)-coonod(2,n1)
              blngth=DSQRT(diffnc(1,2)*diffnc(1,2)+
     +               diffnc(2,2)*diffnc(2,2))
              bmlcos=diffnc(1,2)/blngth
              bmlsin=diffnc(2,2)/blngth
              I1=3*n1-2
              j1=3*n2-2
              ftcons(1)=disdof(J1)-disdof(I1)
              ftcons(2)=disdof(J1+1)-disdof(I1+1)
              ftcons(3)=3*(bmlsin*ftcons(1)-bmlcos*ftcons(2))/blngth
              ftcons(4)=(bmdis1(i)+bmdis2(i))*blngth/2.
              ftcons(5)=2*eyoung*bminer(i)/blngth
              ftcons(6)=eyoung*bmarea(i)*(bmlcos*ftcons(1)+
     +                      bmlsin*ftcons(2))/blngth
              beamcf(3,1)=ftcons(5)*(ftcons(3)+2*disdof(I1+2)+
     +                    disdof(J1+2))-(8.*ftcons(4)-bmdis2(i)*
     +                    blngth/2.)*blngth/90.
              beamcf(3,2)=ftcons(5)*(2*disdof(J1+2)+disdof(I1+2)+
     +                    ftcons(3))+(8.*ftcons(4)-bmdis1(i)*
     +                    blngth/2.)*blngth/90.
              ftcons(7)=(ftcons(4)+bmdis1(i)*blngth/2.)/3.-
     +                  (beamcf(3,1)+beamcf(3,2))/blngth
              ftcons(8)=ftcons(7)-ftcons(4)
              beamcf(1,1)=-bmlcos*ftcons(6)+bmlsin*ftcons(7)
              beamcf(1,2)=bmlcos*ftcons(6)-bmlsin*ftcons(8)
              beamcf(2,1)=-bmlsin*ftcons(6)-bmlcos*ftcons(7)
              beamcf(2,2)=bmlsin*ftcons(6)+bmlcos*ftcons(8)
              DO 720 j=1,2
              DO 720 k=1,3
              reafor(k,nodebm(j,i))=reafor(k,nodebm(j,i))+beamcf(k,j)
  720         CONTINUE
              baxial(i)=ftcons(6)
              bshear(1,i)=ftcons(7)
              bshear(2,i)=ftcons(8)
              bmomnt(1,i)=-beamcf(3,1)
              bmomnt(2,i)=beamcf(3,2)
              if (scrflg .eq. 1) WRITE (*,730) i,n1,n2,
     +                           (beamcf(k,1),k=1,3),(beamcf(k,2),k=1,3)
  730         FORMAT (I5,2I6,1X,6F12.0)
              call diskroom (92)
              WRITE (2,730,err=2000) i,n1,n2,(beamcf(k,1),k=1,3),
     +                               (beamcf(k,2),k=1,3)
          endif
  740     CONTINUE
C
C  Beam loads and stresses
C
          if (scrflg .eq. 1) WRITE (*,750)
  750     FORMAT (//' BEAM LOADS AND STRESSES'//
     +    ' Beam     I     J          PAX         SAX         ',
     +    'SH1         SH2         BM1         BM2'/)
          call diskroom (130)
          WRITE (2,750,err=2000)
          DO 760 i=1,nbeams
          mat=matcbm(i)
          if ((youngm(mat) .ne. 0.) .and. (bmarea(i) .ne. 0.)) then
              ftcons(1)=baxial(i)/bmarea(i)
              if (scrflg .eq. 1) WRITE (*,730) i,(nodebm(k,i),k=1,2),
     +       baxial(i),ftcons(1),(bshear(k,i),k=1,2),(bmomnt(k,i),k=1,2)
              call diskroom (92)
              WRITE (2,730,err=2000) i,(nodebm(k,i),k=1,2),baxial(i),
     +                 ftcons(1),(bshear(k,i),k=1,2),(bmomnt(k,i),k=1,2)
          endif
  760     continue
      endif
C
C  Plate corner forces
C
      IF (nplate .gt. 0) then
          if (scrflg .eq. 1) then
              WRITE (*,770)
  770         FORMAT (//' PLATE CORNER FORCES'//
     +        ' Plate    I     J     K     L       FX1      FY1      ',
     +        'FX2      FY2      FX3      FY3      FX4      FY4'/)
          else
              if (scrflg .eq. 0) write (*,245)
          endif
          call diskroom (138)
          WRITE (2,770,err=2000)
          DO 850 LPL=1,nplate
          TH=plteth(LPL)
          mat=matcpl(lpl)
          eyoung=youngm(mat)
          pratio=poisson(mat)
          if ((th .ne. 0.) .and. (eyoung .ne. 0.)) then
              DO 780 I=1,2
              DO 780 J=1,4
  780         pltecf(I,J)=0.
              IF (nodepl(4,LPL) .EQ. 0) THEN
                  CALL triloads (1,2,3,th,eyoung,pratio,lpl,nodepl)
              ELSE
                  coonod(1,nnodes+1)=(coonod(1,nodepl(1,LPL))+
     +                  coonod(1,nodepl(2,LPL))+coonod(1,nodepl(3,LPL))+
     +                  coonod(1,nodepl(4,LPL)))/4
                  coonod(2,nnodes+1)=(coonod(2,nodepl(1,LPL))+
     +                  coonod(2,nodepl(2,LPL))+coonod(2,nodepl(3,LPL))+
     +                  coonod(2,nodepl(4,LPL)))/4
                  ftcons(7)=0
                  ftcons(8)=0
                  ftcons(9)=0
                  DO 790 i=1,8
                  DO 790 J=1,2
  790             sttemp(i,j)=0.
                  inp(3)=nnodes+1
                  DO 810 I=1,4
                  J=nextid(I,4)
                  inp(1)=nodepl(I,LPL)
                  inp(2)=nodepl(J,LPL)
                  DO 800 N1=1,2
                  DO 800 N2=1,3
  800             diffnc(N1,N2)=coonod(N1,inp(N2))-
     +                          coonod(N1,inp(previd(N2,3)))
                  ftcons(1)=diffnc(2,3)*diffnc(1,2)-
     +                      diffnc(1,3)*diffnc(2,2)
                  ftcons(2)=1/(ftcons(1)*(1+pratio))
                  ftcons(3)=ftcons(2)*(diffnc(1,3)*diffnc(1,2)+
     +                      diffnc(2,3)*diffnc(2,2))
                  ftcons(4)=ftcons(2)*(diffnc(2,3)*diffnc(1,2)-
     +                      diffnc(1,3)*diffnc(2,2))
                  ftcons(5)=ftcons(2)*(diffnc(1,2)*diffnc(1,2)+
     +                      diffnc(2,2)*diffnc(2,2))
                  ftcons(6)=1/(ftcons(1)*(1-pratio))
                  sttemp(2*i-1,1)=sttemp(2*I-1,1)+ftcons(3)+
     +                            ftcons(6)*diffnc(2,2)*diffnc(2,3)
                  sttemp(2*i-1,2)=sttemp(2*I-1,2)+ftcons(4)-
     +                            ftcons(6)*diffnc(2,3)*diffnc(1,2)
                  sttemp(2*i,1)=sttemp(2*I,1)-ftcons(4)-
     +                          ftcons(6)*diffnc(2,2)*diffnc(1,3)
                  sttemp(2*i,2)=sttemp(2*I,2)+ftcons(3)+
     +                          ftcons(6)*diffnc(1,3)*diffnc(1,2)
                  sttemp(2*j-1,1)=sttemp(2*J-1,1)-ftcons(3)-ftcons(5)+
     +                            ftcons(6)*diffnc(2,2)*diffnc(2,1)
                  sttemp(2*j-1,2)=sttemp(2*J-1,2)-ftcons(4)-
     +                            ftcons(6)*diffnc(2,1)*diffnc(1,2)
                  sttemp(2*J,1)=sttemp(2*J,1)+ftcons(4)-
     +                          ftcons(6)*diffnc(2,2)*diffnc(1,1)
                  sttemp(2*J,2)=sttemp(2*J,2)-ftcons(3)-ftcons(5)+
     +                          ftcons(6)*diffnc(1,1)*diffnc(1,2)
                  ftcons(7)=ftcons(7)+ftcons(5)+
     +                      ftcons(6)*diffnc(2,2)*diffnc(2,2)
                  ftcons(8)=ftcons(8)-
     +                      ftcons(6)*diffnc(1,2)*diffnc(2,2)
                  ftcons(9)=ftcons(9)+ftcons(5)+
     +                      ftcons(6)*diffnc(1,2)*diffnc(1,2)
  810             CONTINUE
                  ftcons(1)=0
                  ftcons(2)=0
                  DO 820 I=1,4
                  ftcons(1)=ftcons(1)-
     +                      sttemp(2*I-1,1)*disdof(3*nodepl(I,LPL)-2)-
     +                      sttemp(2*I,1)*disdof(3*nodepl(I,LPL)-1)
                  ftcons(2)=ftcons(2)-
     +                      sttemp(2*I-1,2)*disdof(3*nodepl(I,LPL)-2)-
     +                      sttemp(2*I,2)*disdof(3*nodepl(I,LPL)-1)
  820             CONTINUE
                  ftcons(3)=ftcons(7)*ftcons(9)-ftcons(8)*ftcons(8)
                  disdof(numdof+1)=(ftcons(1)*ftcons(9)-
     +                                ftcons(8)*ftcons(2))/ftcons(3)
                  disdof(numdof+2)=(ftcons(2)*ftcons(7)-
     +                                ftcons(8)*ftcons(1))/ftcons(3)
                  i=-nnodes-1
                  CALL triloads (1,2,i,th,eyoung,pratio,lpl,nodepl)
                  CALL triloads (2,3,i,th,eyoung,pratio,lpl,nodepl)
                  CALL triloads (3,4,i,th,eyoung,pratio,lpl,nodepl)
                  CALL triloads (4,1,i,th,eyoung,pratio,lpl,nodepl)
                  DO 830 I=1,3
  830             plstrs(I,LPL)=plstrs(I,LPL)/4
              ENDIF
              if (scrflg .eq. 1) WRITE (*,840) LPL,(nodepl(k,LPL),k=1,4)
     +                           ,((pltecf(i,j),i=1,2),j=1,4)
  840         FORMAT (I5,4I6,1X,8F9.0)
              call diskroom (104)
              WRITE (2,840,err=2000) LPL,(nodepl(k,LPL),k=1,4),
     +                               ((pltecf(i,j),i=1,2),j=1,4)
          endif
  850     CONTINUE
C
C  Plate load-intensities and stresses
C
          if (scrflg .eq. 1) WRITE (*,860)
  860     FORMAT (//' PLATE LOAD INTENSITIES AND STRESSES'//
     +    ' Plate    I     J     K     L       PIX      PIY      TXY',
     +    '       SX       SY      TAU     SMAX     SMIN     TMAX',
     +    '    Angle'/)
          call diskroom (172)
          WRITE (2,860,err=2000)
          DO 890 LPL=1,nplate
          mat=matcpl(lpl)
          if ((plteth(lpl) .ne. 0.) .and. (youngm(mat) .ne. 0.)) then
              DO 870 I=1,3
  870         plints(I)=plstrs(I,LPL)*plteth(LPL)
              ftcons(3)=SQRT(plstrs(3,LPL)*plstrs(3,LPL)+
     +             .25*(plstrs(2,LPL)-plstrs(1,LPL))*(plstrs(2,LPL)-
     +             plstrs(1,LPL)))
              ftcons(5)=.5*(plstrs(1,LPL)+plstrs(2,LPL))
              ftcons(1)=ftcons(5)+ftcons(3)
              ftcons(2)=ftcons(5)-ftcons(3)
              ftcons(4)=degree(2*plstrs(3,LPL),
     +                         plstrs(2,LPL)-plstrs(1,LPL))/2.
              if (scrflg .eq. 1) WRITE (*,880) LPL,(nodepl(k,LPL),k=1,4)
     +                          ,(plints(k),k=1,3),(plstrs(k,LPL),k=1,3)
     +                          ,(ftcons(k),k=1,4)
  880         FORMAT (I5,4I6,1X,10F9.0)
              call diskroom (122)
              WRITE (2,880,err=2000) LPL,(nodepl(k,LPL),k=1,4),
     +        (plints(k),k=1,3),(plstrs(k,LPL),k=1,3),(ftcons(k),k=1,4)
          endif
  890     CONTINUE
C
C  Plate stresses at node points
C
          if (scrflg .eq. 1) WRITE (*,900)
  900     FORMAT (//' PLATE STRESSES AT NODE POINTS'//
     +    ' Node   Coordinate X   Coordinate Y        SX        SY    ',
     +    '   TAU      SMAX      SMIN      TMAX     Angle'/)
          call diskroom (151)
          WRITE (2,900,err=2000)
          DO 930 I=1,nnodes
          k=0
          DO 910 J=1,3
          IF (pstnor(J,I) .GT. 0.) THEN
              ftcons(J)=pstacc(J,I)/pstnor(J,I)
          ELSE
              k=1
          ENDIF
  910     CONTINUE
          if (k .ne. 1) then
              ftcons(6)=SQRT(ftcons(3)*ftcons(3)+
     +        .25*(ftcons(2)-ftcons(1))*(ftcons(2)-ftcons(1)))
              ftcons(8)=.5*(ftcons(1)+ftcons(2))
              ftcons(4)=ftcons(8)+ftcons(6)
              ftcons(5)=ftcons(8)-ftcons(6)
              ftcons(7)=degree(sngl(2*ftcons(3)),
     +                         sngl(ftcons(2)-ftcons(1)))/2.
              if (scrflg .eq. 1) WRITE (*,920) I,coonod(1,I),coonod(2,I)
     +                           ,(ftcons(k),k=1,7)
  920         FORMAT (I5,3X,F12.5,3X,F12.5,7F10.0)
              call diskroom (107)
              WRITE (2,920,err=2000) I,coonod(1,I),coonod(2,I),
     +                               (ftcons(k),k=1,7)
          endif
  930     CONTINUE
      endif
C
C  Fastener forces and stresses
C
      IF (nfastn .gt. 0) then
          if (scrflg .eq. 1) then
              WRITE (*,940)
  940         FORMAT (//' FASTENER FORCES AND STRESSES'//
     +        ' Fastener I     J         FX        FY         F     ',
     +        'Angle    Stress'/)
          else
              if (scrflg .eq. 0) write (*,385)
          endif
          call diskroom (113)
          WRITE (2,940,err=2000)
          DO 960 LFS=1,nfastn
          if (fsstif(lfs) .ne. 0.) then
              n1=nodefs(1,LFS)
              n2=nodefs(2,LFS)
              I1=3*n1-2
              J1=3*n2-2
              ftcons(1)=fsstif(lfs)*(disdof(I1)-disdof(J1))
              ftcons(2)=fsstif(lfs)*(disdof(I1+1)-disdof(J1+1))
              ftcons(3)=SQRT(ftcons(1)*ftcons(1)+ftcons(2)*ftcons(2))
              ftcons(4)=degree(sngl(ftcons(2)),sngl(ftcons(1)))
              ftcons(5)=ftcons(3)/fsarea(lfs)
              if (scrflg .eq. 1) WRITE (*,950) LFS,n1,n2,
     +                                         (ftcons(k),k=1,5)
  950         FORMAT (I5,2I6,1X,5F10.0)
              call diskroom (70)
              WRITE (2,950,err=2000) LFS,n1,n2,(ftcons(k),k=1,5)
              reafor(1,n1)=reafor(1,n1)+ftcons(1)
              reafor(1,n2)=reafor(1,n2)-ftcons(1)
              reafor(2,n1)=reafor(2,n1)+ftcons(2)
              reafor(2,n2)=reafor(2,n2)-ftcons(2)
          endif
  960     CONTINUE
      endif
C
C  Node internal forces and reactions
C
      reaclb(1)='        '
      reaclb(2)='        '
      reaclb(3)='Reaction'
      if (scrflg .eq. 1) then
          WRITE (*,970)
  970     FORMAT (//' NODE INTERNAL FORCES AND REACTIONS'//
     +    ' Node   Coordinate X   Coordinate Y          FX',
     +    '                    FY                    MZ'/)
      else
          if (scrflg .eq. 0) write (*,972)
  972     format ('Reactions...'\)
      endif
      call diskroom (142)
      WRITE (2,970,err=2000)
      DO 990 I=1,nnodes
      if (scrflg .eq. 1) WRITE (*,980) I,coonod(1,I),coonod(2,I),
     +             (reafor(j,I),reaclb(1+abs(igndof((i-1)*3+j))),j=1,3)
  980 FORMAT (I5,3X,F12.5,3X,F12.5,3(F12.0,1x,a8,1x))
      call diskroom (103)
      WRITE (2,980,err=2000) I,coonod(1,I),coonod(2,I),
     +             (reafor(j,I),reaclb(1+abs(igndof((i-1)*3+j))),j=1,3)
  990 CONTINUE
      if (scrflg .eq. 0) write (*,512)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                       REPORT THE EXECUTION TIME                      C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C  Report the execution time
C
  994 cpusec=0.
      call time (lasthr,lastmn,lastsc,lasths)
      if (lasthr .lt. inithr) cpusec=86400.
      cpusec=cpusec+3600.*(lasthr-inithr)+60.*(lastmn-initmn)+lastsc-
     +       initsc+.01*(lasths-iniths)
      if (scrflg .ge. 0) write (*,995) cpusec
  995 format (//' Execution time : ',f8.2,' seconds.')
      if (ierror .ne. -1) then
          call diskroom (43)
          write (2,995,err=2000) cpusec
      endif
      write (*,999)
  999 format (' ')
      STOP
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                REPORT UNSPECIFIED I/O ERRORS DETECTED                C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1000 write (*,1010)
 1010 format (//' ERROR : CANNOT READ INPUT FILE.'/
     +          ' The program cannot continue.')
      goto 994
 2000 write (*,2010)
 2010 format (//' ERROR : CANNOT WRITE OUTPUT FILE.'/
     +          ' The program cannot continue.')
      ierror=-1
      goto 994
      END
